perm filename MSSET.F4[NEW,LCS] blob
sn#717316 filedate 1983-06-18 generic text, type T, neo UTF8
C MSSET.F4,GRCSHF,STORE,MOVE1,RHEQ,ADJX,COMBI,INSPT,LASTMV,FIB
C THIS ROUTINE CALLED BY MS - OR BY JUST.
SUBROUTINE MSSET(NSTF)
COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM
1/RINP/P(250),RHY(250),NO(400) /WHICH/SIZ(3),WHICH(3)
COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /MEDIT/MEDIT,IGO
CC COMMON/RINP/NSTF(500),NO(400) /MEDIT/MEDIT,IGO
CC COMMON /SET/P(200),RHY(200),SIZ(3),WHICH(3)
DATA SIZ/4.0,7.0,5.0/,WHICH/-0.200,-0.400,-0.300/
IGO=0
C IGO=0 SUPPRESSES ALL BUT LAST DPYOUT
C IF(IDEV.NE.5)GO TO 100
C CALL TYPSTR
C 1 (' DO YOU REALLY WANT TO LINE UP EVERYTHING? (Y-N) ')
C101 FORMAT(1A1)
C ACCEPT 101,K
C IF(K.NE.LYY)RETURN
100 GRACE=4./88.
C VALUE OF GRACE NOTE
C JA=0 UPON ARRIVAL HERE.
CALL ORDER(ITEM)
C ORDER ALL ITEMS BY STAFF NUM.
TOTSTF=NSTF*8-1
C TOTSTF=TOTAL STAVES-1 STAFF COUNT BEGINS WITH 0.
J=1
RST=0
N=0
I=1
4 RRH=0
NTRST=0
C FLAG FOR 1ST NOTE OR REST
N=I-1
C RRH WILL HOLD RHY TOTAL OF STAFF 0
C I POINTS TO START OF CURRENT (UPPER) STAFF
DO 1 K=J,ITEM
L=KWDS(K)
R2=RN(L+2)
IF(R2.NE.RST)GO TO 1
R1=RN(L+1)
IF(R1.LE.2.0)GO TO 6
C FOUND NOTE OR REST
IF(R1.NE.4.0)GO TO 7
IF(RN(L).GT.3.0)GO TO 1
C FOUND BARLINE
GO TO 6
8 L=1
C FOR BARLINE (.2*20 = 4 STEPS)
IF(R1.GE.17.0)L=R1-15
RH=WHICH(L)
GO TO 3
7 IF(R1.LT.17.0)GO TO 1
C FOUND KSIG OR METER
6 R3=RN(L+3)
RA=RN(L)
IF(R1.EQ.2.0)GO TO 2
IF(R1.GT.2.0)GO TO 8
IF(RA.LT.7.0)GO TO 1
RH=RN(L+9)
IF(ABS(RH-GRACE).GT.0.01)GO TO 30
C SKIP IF NOT GRACE NOTE
IF(RST.EQ.0.OR.NTRST.LT.0)GO TO 1
C NOW GRACE NOTE IS FIRST ON AN UPPER STAFF
IF(R3.GE.P(1))CALL GRCSHF(R3,K)
C SKIP IF TO LEFT OF 1ST NOTE, STAFF 0
C GO SHIFT GRACE NOTES TO LEFT OF 1ST NOTE
GO TO 1
2 IF(RA.LT.5.0)GO TO 1
RH=RN(L+7)
30 IF(RH.LE.0)GO TO 1
NTRST=-1
3 IF(NTRST.EQ.0)GO TO 1
C DON'T STORE BAR,METER,KSIG UNTIL AFTER 1ST NOTE OR REST
N=N+1
IF(RH.GT.0)RRH=RRH+RH
C ADD UP TOTAL RHYTHM
CALL STORE(N,RH,R2,R3)
J=K
1 CONTINUE
IF(RRH.EQ.0)GO TO 5
C SKIP IF NO RHYTHMS ON THIS STAFF
CALL RHEQ(RRH,RST)
CHECK IF RHYTHM OF THIS STAFF = TOTAL OF STAFF 0
CALL MOVE1(I,N,RST)
C GO MOVE EVERYTHING TO EXACT RHYTHMIC POS
IF(RST.EQ.0)I=N+1
C I POINTS TO START OF CURRENT STAFF
IF(RST.GT.0)CALL COMBI(N,I,RST)
C GO COMBINE RHYTHMS - FIND SMALLEST VALUES
TYPE 9,RST
9 FORMAT(' STAFF',1F3.0)
5 RST=RST+1
C GET READY FOR NEXT STAFF
IF(RST.LE.TOTSTF)GO TO 4
C NO MORE STAVES? NOW MOVE ALL TO PROPER POSITIONS.
CALL ADJX
C ADJUST CLEFS, KSIGS, METERS
R2=999.
R4=2000.0
R5=2200.0
C R4, R5 NEEDED IN GETPTS
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,-2000.,0)
C MOVE ALL LEFT OVER (UP TO POS. 200) BACK TO PROPER POSITIONS.
CALL LASTMV(I)
END
SUBROUTINE GRCSHF(R3,K)
C GRACE NOTE SHIFTER (IF 1ST IN AN UPPER STAFF)
COMMON /XRN/RN(1) /RINP/P(250),RHY(250),NO(1)
COMMON /LIMIT/LIMIT,ITEM
COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /PTR/KWDS(1)
R4=R3
C FOR GETPTS
DO 10 KK=K+1,ITEM
C LOOK FOR NEXT REAL NOTE OR REST
R1=CODN(KK,L)
IF(R1.GT.2.0)GO TO 10
IF(ABS(RN(L+4))+20.0.GE.100.0)GO TO 10
C SKIP IF NEXT IS ANOTHER GRACE NOTE
R3=RN(L+3)-R3
C DIFFERENCE IN POS. OF GRACE NOTE AND NEXT REAL NOTE
GO TO 11
10 CONTINUE
C ERROR IF WE GET HERE WITHOUT JUMPING OUT OF LOOP
11 R5=R4+R3-.1
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,P(1)-R5,0)
C MOVE GRACE NOTES TO LEFT OF 1ST NOTE, STAFF 0
END
SUBROUTINE STORE(N,RH,R2,R3)
COMMON /RINP/P(250),RHY(250)
P(N)=R3
RHY(N)=RH
IF(N.EQ.1.OR.R3.NE.P(N-1))RETURN
N=N-1
3 TYPE 30,R3,RH,RHY(K),R2
30 FORMAT(' *** TWO RHYTHMS AT POS.= ',3F7.3,' STAFF =',F3.0)
PAUSE
END
SUBROUTINE MOVE1(I,N,RST)
COMMON /XRN/RN(1) /RINP/P(250),RHY(250),NO(1)
COMMON R2,JA,CENTR,J2,RJ3,R4,R5
IF(RST.NE.0)GO TO 1
C SET FOR 1ST STAFF (0)
POS1=P(1)
C R4,R5 = POS. LIMITS TO LOOK IN
1 R4=0
R5=1999.0
C R4, R5 NEEDED IN GETPTS
R2=RST
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,2000.,0)
C SHIFT ALL 2000 TO RIGHT. SHIFT BACK WHEN ALL DONE.
POSX=POS1
P(N+1)=200.0
C PUT END OF LINE VALUE IN NEXT POSITION SLOT.
K=I
NN=N+1
3 POSY=POSX+ABS(RHY(K)*20.0)
C POSITION OF NEXT RHYTHMIC POINT.
CALL MOVIT(RN,NO,P(K)+2000.,P(K+1)+2000.,POSX,POSY)
C MOVE ALL FROM CURRENT POS TO LIMITS OF STAFF 0' RHYTHMS
P(K)=POSX
C RESET POSITION OF THIS RHYTHM
2 POSX=POSY
K=K+1
IF(K.LE.NN)GO TO 3
C NOW ALL MOVED TO PROPER RHYTHMIC POSITIONS AND ALIGNED WITH STAFF 0.
P(N+1)=0
END
SUBROUTINE RHEQ(RRH,RST)
IF(RST.NE.0)GO TO 1
RHTOT=RRH
RETURN
1 IF(ABS(RRH-RHTOT).LT.0.1)RETURN
TYPE 2,RHTOT,RST,RRH
PAUSE
2 FORMAT(' TOTAL RHYTHM STAFF 0 = ',F6.3,
1' STAFF ',F2.0,' = ',F6.3)
END
SUBROUTINE ADJX
COMMON /XRN/RN(1) /PTR/KWDS(1) /LIMIT/LIMIT,ITEM
COMMON /RINP/P
DIMENSION CLKSMT(3)
DATA CLKSMT/3.0,17.0,18.0/
X=P+2000.0
C THIS ROUTINE LOOKS AT ITEMS NOT YET SHIFTED BACK 2000.
DO 5 JJ=1,3
R1=CLKSMT(JJ)
DO 1 K=1,ITEM
L=KWDS(K)
IF(RN(L+2).NE.0)GO TO 1
IF(R1.NE.RN(L+1))GO TO 1
C NOW LOOK AT CLEFS, METER, AND KSIG
R3=AMOD(RN(L+3),2000.0)
IF(R3.GT.P)GO TO 1
CC IF(R3.GT.X)GO TO 1
C LOOK ONLY BEFORE FIRST NOTE OR REST.
DO 2 J=1,ITEM
L=KWDS(J)
IF(RN(L+2).EQ.0)GO TO 2
IF(R1.NE.RN(L+1))GO TO 2
RR3=RN(L+3)
IF(RR3.GT.X.OR.RR3.LT.2000.0)GO TO 2
C LOOK ONLY BEFORE FIRST NOTE OR REST FOR NON-SHIFTED ITEMS.
IF(R1.NE.3.0)GO TO 3
IF(RN(L).GT.3.0)GO TO 2
C SKIP IF NOT REAL CLEF
3 RN(L+3)=R3
C LINE UP ITEM WITH POS. OF SAME ITEM ON STAFF 0
2 CONTINUE
1 CONTINUE
5 CONTINUE
END
SUBROUTINE COMBI(N,I,RST)
COMMON R2,JA,CENTR,J2,RJ3,R4,R5
COMMON /XRN/RN(1) /PTR/KWDS(1)
1 /RINP/P(250),RHY(250),NO(1) /WHICH/SIZ(3),WHICH(3)
EQUIVALENCE (BR,WHICH),(RKS,WHICH(2))
C BR=-0.2 RHY VAL FOR BARLINE, RKS=-0.4 KSIG
L=1
M=I
R5=1999.0
R2=RST
X=0
100 IF(L.LT.I)GO TO 102
C NOW ADD THINGS FROM END OF UPPER STAFF.
P(L)=P(M)
RHY(L)=RHY(M)
I=I+1
C UPDATE START OF M ARRAY
GO TO 300
102 RL=RHY(L)
RM=RHY(M)
IF(ABS(RM-RL).GE.0.01)GO TO 1
C SKIP IF (ALMOST) NOT SAME RHY IN BOTH STAVES
300 M=M+1
IF(M.GT.N)RETURN
200 L=L+1
GO TO 100
1 IF(RM.LT.0)GO TO 4
C <0 = BAR, KSIG, METER
IF(RL.LT.0)GO TO 5
IF(AMOD(RM,RL).GT.0.01.AND.AMOD(RL,RM).GT.0.01)GO TO 101
C JUMP IF ONE RHY DOES NOT DIVIDE EVENLY INTO THE OTHER.
X=RL-RM
IF(X.LT.0)GO TO 2
J=1
C GO INSERT POINT FROM M STAFF
GO TO 10
2 RHY(M)=-X
C X IS NEG. RESET UPPER RHY. TO DIFFERENCE
P(M)=P(L+1)
C USE POSITION OF RHY ON STAFF 0
GO TO 200
C NEXT FINDS NEXT RHYTHMIC MEETING OF THE PARTS.
101 A=RL
B=RM
CURRENT RHYTHMIC VALS.
D=RL
E=RM
C USED TO FIND SHORTEST RHYTHMIC VAL.
MM=M
LL=L
C POINTERS FOR STEP AHEAD IN EACH LIST
GO TO 99
C ADD UP RHY. VALS.
93 C=A-B
IF(D.GT.RHY(LL))D=RHY(LL)
IF(E.GT.RHY(MM))E=RHY(MM)
C FIND SHORTEST RHY VAL IN EACH STAFF
IF(ABS(C).LT.0.01)GO TO 91
C JUMP IF TOTALS ARE THE SAME FOR EACH STAFF.
99 IF(A.GT.B)GO TO 92
C STEP AHEAD IN STAFF 0 NOW
LL=LL+1
A=A+RHY(LL)
GO TO 93
92 MM=MM+1
C STEP AHEAD IN UPPER STAFF
B=B+RHY(MM)
GO TO 93
91 J=(MM-M)-(LL-L)
IF(J)97,96,95
C MORE RHYS BELOW, SAME, ABOVE
97 L=LL+1
M=MM+1
C MORE RHYS BELOW, SKIP ALL ABOVE UNTIL NEXT MATCHUP
98 IF(M.GT.N)RETURN
GO TO 100
95 JM=MM-M+1
N=N+J
I=I+J
DO 81 K=N,L+JM,-1
RHY(K)=RHY(K-J)
81 P(K)=P(K-J)
C ABOVE OPENS SPACE FOR INSERT OF UPPER RHYS.
M=M+J
C PUSH OVER POINTER TO UPPER STAFF DATA
DO 80 K=L,LL+J
RHY(K)=RHY(M)
P(K)=P(M)
80 M=M+1
C INSERT DONE
L=L+JM
GO TO 98
96 IF(ABS(D-E).LE.0.01)GO TO 82
C NOW SAME NUM OF RHYS IN EACH STAFF
IF(D.LT.E)GO TO 97
C JUMP IF SMALLEST RHY IS IN STF 0
DO 90 K=L,LL
RHY(K)=RHY(M)
P(K)=P(M)
90 M=M+1
GO TO 97
82 RL=RHY(L)
RM=RHY(M)
IF(RL.GT.RM)GO TO 84
C NOW USE ALL RHYS, SHORTEST IN BOTH, DIFF. PLACES
RHY(M)=RM-RL
L=L+1
P(M)=P(L)
IF(L.GT.LL)GO TO 100
C JUMP OUT IF UP NEXT RHYTHMIC MATCH POINT
GO TO 82
84 X=RL-RM
CALL INSPT(L,M,X,I,N,1)
C GO INSERT POINT FROM M STAFF
IF(M.GT.N)RETURN
IF(M.GT.MM)GO TO 100
C JUMP OUT IF UP NEXT RHYTHMIC MATCH POINT
GO TO 82
4 IF(RL.LT.0)GO TO 6
C JUMP IF NON-NOTE ON BOTH STAVES
C NOW RM <0, RL >0, INSERT M DATA IN L ARRAY
X=RL
J=0
7 Y=-RM*20.0
C NOW MOVE ITEMS ON STAFF 0 TO RIGHT
R4=P(M)
R2=999.0
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,Y,0)
DO 11 K=L,I-1
C SHIFT POINTERS TO ITEMS OF STAFF 0
11 P(K)=P(K)+Y
C GO INSERT STUFF IN L ARRAY
IF(X.EQ.0)GO TO 10
C NOW MOVE UPPER STAFF DATA BACK TO LEFT
R2=RST
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,-Y,0)
10 CALL INSPT(L,M,X,I,N,J)
C J IS FOR VARIOUS INSRT SITUATIONS
IF(M.GT.N)RETURN
GO TO 100
6 IF(RM.EQ.BR)GO TO 7
C BOTH NEG. BUT RM IS A BAR LINE. GO INSERT IT.
X=0
IF(RL.NE.BR)GO TO 8
C NOW L IS BAR BUT NOT M. MOVE M TO RIGHT
Z=4.0
12 R4=P(M)
R2=RST
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,Z,0)
DO 9 K=M,N
9 P(K)=P(K)+Z
C SHIFT THINGS IN M ARRAY (UPPER STAFF)
GO TO 200
8 IF(RM.NE.RKS)GO TO 13
C ABOVE MEANS M IS A KSIG, L IS A METER
X=RL
CC J=1
J=0
GO TO 7
13 Z=8.0
C NOW L IS A KSIG, M IS A METER
GO TO 12
5 Z=-RL*20.0
C L HAS BAR, KSIG, OR METER. M HAS NOTE, ETC.
GO TO 12
END
SUBROUTINE INSPT(L,M,X,I,N,J)
COMMON /RINP/P(250),RHY(250)
C INSERTS SINGLE RHY FROM UPPER STAFF (M ARRAY)
10 N=N+1
I=I+1
DO 3 K=N,L+1,-1
P(K)=P(K-1)
3 RHY(K)=RHY(K-1)
M=M+1
C M+1 BECAUSE ARRAY EXPANDED BY 1
RHY(L)=RHY(M)
C INSERT NEW RHYTHM
P(L+J)=P(M+J)
C J=0(INSERT BAR, ETC.) OR =1 (INSERT NOTE, REST)
M=M+1
L=L+1
RHY(L)=X
END
SUBROUTINE LASTMV(I)
COMMON R2,JA,CENTR,J2,RJ3,R4,R5 /STF/RSTFAC
COMMON /XRN/RN(1) /PTR/KWDS(1) /WHICH/SIZ(3),WHICH(3)
COMMON /RINP/P(250),RHY(250),NO(1)
CC DATA SIZ/4.0,7.0,5.0/,WHICH/-0.2,-0.4,-0.3/
C SPACE REQUIREMENTS FOR BARLINE=4, KSIG=8, METER=5
N=I-1
J=0
R2=999.0
R4=P(1)
R5=5000.0
CALL GETPTS(1)
CALL MOVIT(RN,NO,R4,R5,2000.0,0)
C MOVE ALL OUT TO RIGHT AGAIN
A=P(1)
10 J=J+1
RH=RHY(J)
IF(RH.GT.0)GO TO 13
ENDI=X
IF(RH.EQ.WHICH(1))BAR=X
C FIND LAST BAR AND LAST KSIG OR METER. USE PREVIOUS POS.
DO 11 K=1,3
11 IF(RH.EQ.WHICH(K))X=SIZ(K)*RSTFAC+A
C STAFF 0 SIZE DETERMINES ACTUAL SPACE FOR BAR, KSIG, METER.
GO TO 12
13 X=FIB(RH)+A
C GET FIBONOCCI SPACE TO NEXT NOTE OR REST
12 CALL MOVIT(RN,NO,P(J)+2000.0,P(J+1)+2000.01,A,X+0.01)
C MOVE BACK INTO FINAL POSITION. (.01 NEEDED FOR ROUND OFF PROB.)
A=X
C SET NEXT POSITION POINTER
IF(J.LT.N)GO TO 10
C NOW FIND LAST BAR AND LAST KSIG AND/OR METER
R4=0
CALL GETPTS(1)
CALL MOVIT(RN,NO,BAR+0.01,2000.0,200.0,0)
C MOVE STUFF (IF ANY) BEYOND BARLINE 200 TO RIGHT
4 CALL MOVIT(RN,NO,P(1),BAR+0.01,P(1),200.0)
C P(1)=POS. OF 1ST NOTE, ETC., STF 0. MOVES ALL INTO GIVEN LIMITS.
IF(BAR.EQ.ENDI)GO TO 15
X=2.5
IF(RHY(N-1).NE.WHICH(1))X=13.0
C IF PREVIOUS ITEM IS NOT BAR THEN IT MUST BE KSIG - MORE SPACE NEEDED.
CALL MOVIT(RN,NO,200.1,2000.0,RSTFAC*X-ENDI,0)
C MOVE BACK ITEMS BEYOND LAST BARLINE.
15 CALL MOVIT(RN,NO,2000.0,5000.0,201.0,201.0)
CATCH END POINTS OF SLURS, ETC. MOVE THEM ALL BACK
C****
C ADD HERE ROUTINE TO SET KSIG AND METER BEYOND 200 TO EXACT POSITION.
END
FUNCTION FIB(VAL)
DATA AL/0.5849624/
FIB=14.0*EXP(ALOG(VAL)*AL)
C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
END